home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / MyTermination.p < prev    next >
Encoding:
Text File  |  1995-08-04  |  1.0 KB  |  58 lines  |  [TEXT/CWIE]
  1. unit MyTermination;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.         
  8.     procedure InitTermination(term:ProcPtr); { ProcPtr! Not UniversalProcPtr! }
  9.     procedure FinishTermination;
  10.     
  11. implementation
  12.  
  13.     uses
  14.         Traps,MyCallProc,MyUtils,PreserveA5;
  15.  
  16.     var
  17.         gTermination:UniversalProcPtr;
  18.         gExitToShell:UniversalProcPtr;
  19.         
  20.     procedure CallTermination;
  21.         var
  22.             tmp:UniversalProcPtr;
  23.     begin
  24.         if gTermination<>nil then begin
  25.             tmp:=gTermination;
  26.             gTermination:=nil;
  27.             CallPascal0(tmp);
  28.         end;
  29.     end;
  30.     
  31.     procedure ExitToShellPatch;
  32.         var
  33.             olda5:Ptr;
  34.             lExitToShell:UniversalProcPtr;
  35.     begin
  36.         olda5:=SetPreservedA5;
  37.         CallTermination;
  38.         lExitToShell:=gExitToShell;
  39.         RestoreA5(olda5);
  40.         CallPascal0(lExitToShell);
  41.     end;
  42.  
  43.     procedure InitTermination(term:ProcPtr);
  44.     begin
  45.         if term<>nil then begin
  46.             gTermination:=NewProc(term,uppPascal0ProcInfo);
  47.             gExitToShell:=MyGetTrapAddress(_ExitToShell);
  48.             MySetTrapAddress(NewProc(@ExitToShellPatch,uppPascal0ProcInfo),_ExitToShell);
  49.         end;
  50.     end;
  51.     
  52.     procedure FinishTermination;
  53.     begin
  54.         CallTermination;
  55.     end;
  56.     
  57. end.
  58.